home *** CD-ROM | disk | FTP | other *** search
/ Educational Software Cooperative 4 / Educational Software Cooperative 4.iso / lights22 / weep.cpr / SS_DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-06-22  |  9.9 KB  |  374 lines
  1. {$A-,B-,D+,F-,G+,I-,K-,L+,N-,P-,Q-,R-,S-,T-,V+,W-,X+,Y+}
  2. {$M 8192,8192}
  3. {************************************************}
  4. {                                                }
  5. {   Turbo Pascal for Windows                     }
  6. {   Screen Saver Demo for Windows                }
  7. {   Copyright (c) 1992 by Thomas H÷vel           }
  8. {   Requires 'The Lights Go Down'                }
  9. {                                                }
  10. {************************************************}
  11.  
  12. {
  13.   Diese Datei zeigt das Grundgeruest eines LGD-Bildschirmschoners.
  14.  
  15.   LGD sucht nach Dateien, die dem Schema SS_*.LGD entsprechen. Die .LGD-
  16.   Dateien sind normale .DLLs, die lediglich umbenannt wurden.
  17.  
  18.   Tip für TPW: In der Datei WEEP.INI kann im Abschnitt [LGD] der Eintrag
  19.   Debug=1 eingefügt werden. Danach sucht LGD nach SS_*.DLL, d.h. zum Testen
  20.   muß die DLL nicht mehr umbenannt werden.
  21.  
  22.   Grundsaetzlicher Aufbau:
  23.  
  24.   Die .DLL (spaeter SS_*.LGD genannt) stellt folgende vier Funktionen
  25.   zur Verfügung:
  26.     ScreenSaverID      index 17
  27.     ScreenSaverOptions index 18
  28.     ScreenSaver        index 19
  29.     ScreenSaverAbout   index 20
  30.  
  31.   ScreenSaverID dient zur Identifikation. Sie übergibt Namen und Beschreibung
  32.     des Schoners und zeigt an, welche Funktionen unterstützt werden.
  33.   ScreenSaver ist der eigentliche Schoner. In der Regel wird diese Funktion
  34.     eine Fensterklasse eintragen, ein Fenster oeffnen und auf WM_QUIT warten.
  35.   ScreenSaverAbout ist eine optionale Funktion. Sie ermöglicht dem Autor
  36.     eines Schoner-Moduls eine angemessene Selbstdarstellung.
  37.   ScreenSaverOptions erlaubt dem Benutzer, bestimmte Parameter des Schoners
  38.     zu veraendern. Diese Parameter sollten in einer .INI-Datei gespeichert
  39.     werden. Diese Funktion ist optional.
  40.  
  41.   Die Parameter der einzelnen Funktionen werden weiter unten beschrieben.
  42.  
  43. }
  44.  
  45. { $define COL256}  { unterstⁿtzung fⁿr farbpalette mit 256 farben }
  46.  
  47. { $define RUN}   { mit RUN: standalone (.EXE), sonst .DLL }
  48. {$ifndef RUN}
  49. library ss_Demo;
  50. {$endif}
  51.  
  52. {$c preload}
  53.  
  54. uses
  55. {$ifdef COL256}
  56.   ssCommon,            { definitionen fⁿr farbpalette }
  57. {$endif}
  58.   WinTypes, WinProcs, lm_lgd, strings;
  59.  
  60. const AppName = 'LGD_DEMO';
  61.  
  62. var
  63.     lEndTime: LongInt;   { zeitdauer (fⁿr Randomizer) }
  64.     fExit: LongInt;      { ende durch eingabe ? }
  65. {$ifdef COL256}
  66.     pif: PInterFace;     { zeiger auf parameterstruktur (von LGD ⁿbergeben) }
  67.     fFirstDC: boolean;
  68. {$endif}
  69.  
  70.  
  71. { WindowProc des Bildschirmschoners }
  72. { In der Regel wird der Schoner über WM_TIMER bzw. über PeekMessage bestimmte
  73.   Zeichenaktionen ausloesen.
  74. }
  75.  
  76. function WindowProc(Window: HWnd; Message, WParam: Word;
  77.   LParam: Longint): Longint; export;
  78. var
  79.   hMen: hMenu;
  80.   fFlag: Bool;
  81.   w: Word;
  82.   ps: TPaintStruct;
  83.   dc: HDC;
  84.   lRet: LongInt;
  85. begin
  86.   WindowProc := 0;
  87.   if (LgdDefProc (lRet, window, Message, wParam, lParam)) then
  88.     begin
  89.       WindowProc := lRet;
  90.       exit;
  91.     end;
  92.  
  93.   case Message of
  94.     wm_Paint:
  95.       begin
  96.     dc := BeginPaint (window, ps);
  97. {$ifdef COL256}
  98.     if fFirstDC then
  99.       begin
  100.         UnrealizeObject(pif^.hPal);                       
  101.         RealizePalette(dc);                    
  102.         fFirstDC := FALSE;
  103.         { es gibt wahrscheinlich elegantere wege, dies zu erledigen ...
  104.           ... vielleicht mit WM_QUERYNEWPALETTE ...
  105.           wir arbeiten dran ... }
  106.       end;
  107. {$endif}
  108.           { hier: eigene zeichenroutinen einbauen }
  109.     EndPaint (window, ps);
  110.     exit;
  111.       end;
  112.  
  113.     wm_Create:
  114.       begin
  115.       end;
  116.  
  117. {    wm_EraseBkgnd:
  118.       begin
  119.     WindowProc := 1;
  120.     exit;
  121.       end;}
  122.  
  123.    wm_Size:
  124.       begin
  125. {       cxClient := LOWORD (lParam);
  126.     cyClient := HIWORD (lParam);
  127.     exit;}
  128.       end;
  129.  
  130.     wm_Timer:
  131.       begin
  132.     if GetCurrentTime >= lEndTime then
  133.       begin
  134.         fExit := 0;
  135.         DestroyWindow (window);
  136.         exit;
  137.       end;
  138.       end;
  139.  
  140.     wm_KillFocus:
  141.       begin
  142.     if fExit = -1 then
  143.       begin    { ende vorbereiten }
  144.         PostMessage (window, wm_Close, 0, 0);
  145.       end;
  146.       end;
  147.  
  148.  
  149.     wm_KeyDown,          { jeder tastendruck beendet den Saver }
  150.     wm_Close,
  151.     wm_lButtonDown,
  152.     wm_mButtonDown,
  153.     wm_rButtonDown:
  154.       begin
  155.     fExit := 1;   { randomizer mu▀ zwischen timeout und abbruch unterscheiden k÷nnen! }
  156.     DestroyWindow (window);
  157.     exit;
  158.       end;
  159.  
  160.     wm_Destroy:
  161.       begin
  162.     KillTimer (window, 1000);
  163.     PostQuitMessage(0);
  164.     Exit;
  165.       end;
  166.   end;
  167.   WindowProc := DefWindowProc(Window, Message, WParam, LParam);
  168. end;
  169.  
  170.  
  171. { ScreenSaver - duration: Laufzeit (in Sekunden, <= 0 -> unendlich
  172.         Flags   : reserviert
  173. }
  174.  
  175. Function ScreenSaver (duration: LongInt; Flags:LongInt): LongInt;
  176. {$ifndef RUN}
  177. export;
  178. {$endif}
  179. var
  180.   Window: HWnd;
  181.   Message: TMsg;
  182.   f:boolean;
  183.   cCursor, i: integer;
  184. const
  185.   WindowClass: TWndClass = (
  186.     style: cs_HREDRAW + cs_VREDRAW;
  187.     lpfnWndProc: @WindowProc;
  188.     cbClsExtra: 0;
  189.     cbWndExtra: 0;
  190.     hInstance: 0;
  191.     hIcon: 0;
  192.     hCursor: 0;
  193.     hbrBackground: 0;
  194.     lpszMenuName: nil;
  195.     lpszClassName: AppName);
  196. begin
  197.   Randomize;
  198.   fExit := -1;
  199. {$ifdef COL256}
  200.   pif := pointer (flags);
  201.   if pif <> nil then
  202.     if (pif^.lLevel <> 0) or
  203.        (pif^.lMagic <> $12348765) then
  204.       pif := nil;     { struktur nicht erkannt }
  205.   fFirstDC := TRUE;
  206. {$endif}
  207.  
  208.   if HPrevInst = 0 then
  209.   begin
  210.     WindowClass.hInstance := HInstance;
  211.     WindowClass.hIcon := 0;
  212.     WindowClass.hCursor := LoadCursor(0, idc_Cross);
  213.     WindowClass.hbrBackground := GetStockObject(black_Brush);
  214.     if not RegisterClass(WindowClass) then
  215.     ;
  216.   end;
  217.   Window := CreateWindow(
  218.     AppName,
  219.     AppName,
  220.     ws_PopUp or ws_Border,
  221.     0,
  222.     0,
  223.     0,
  224.     0,
  225.     0,
  226.     0,
  227.     HInstance,
  228.     nil);
  229.   UpdateWindow(Window);
  230.   SetWindowPos (Window, 0, -1, -1,
  231.         GetSystemMetrics (sm_cxScreen)+2,
  232.         GetSystemMetrics (sm_cyScreen)+2,
  233.         swp_noZOrder);
  234.  
  235.   ShowWindow (window, sw_Normal);
  236.  
  237.   cCursor := 0;
  238.   repeat
  239.     i := ShowCursor (false);
  240.     inc (cCursor);
  241.   until i < 0;
  242.  
  243.   if duration > 0 then
  244.     lEndTime := GetCurrentTime + duration * 1000
  245.   else
  246.     lEndTime := $7fffffff;
  247.   SetTimer (window, 17, 1000, nil);
  248.  
  249.   while GetMessage(Message, 0, 0, 0) do
  250.   begin
  251. {    if (TranslateAccelerator (window, hAccel, Message) = 0) then
  252.       begin}
  253.     TranslateMessage(Message);
  254.     DispatchMessage(Message);
  255. {      end;}
  256.   end;
  257.  
  258.   while cCursor > 0 do
  259.     begin
  260.       ShowCursor (true);
  261.       dec (cCursor);
  262.     end;
  263.  
  264.   UnregisterClass (AppName, hInstance);
  265.   ScreenSaver := fExit;
  266. end;
  267.  
  268.  
  269. { ScreenSaverID - Identifikation des Schoners
  270.     Parameter:
  271.       wMagic    : muß bei der Rückkehr einen bestimmten Wert enthalten ($6874)
  272.       fFunctions: Bit 0  About-Funktion wird unterstützt
  273.           Bit 1  Options-Funktion wird unterstützt
  274.       achName   : Name des Schoners - daß erste Zeichen des Namens wird nicht
  275.           angezeigt, es legt bloß die Sortierung fest.
  276.       cchName   : Länge des Puffers für achName
  277.       achDesc   : Beschreibung des Schoners, bis max. ca. 8 Zeilen a 30 Zeichen
  278.           Beschreibung kann #10 (\n) (Zeilenvorschub) enthalten
  279.       cchDesc   : Länge des Puffers für Beschreibung
  280. }
  281.  
  282. Procedure ScreenSaverID (var wMagic:integer;
  283.              var fFunctions:LongInt;
  284.                  achName:pchar;
  285.                  cchName:integer;
  286.                  achDesc:pchar;
  287.                  cchDesc:integer);
  288. export;
  289. begin
  290.   wMagic := $6874;
  291.   fFunctions := 16+8+1;    { 1: about, 2:options, 3:both }
  292.               { 4: non-blank (nicht-leerer bildschirm erforderlich }
  293.               { 8: hinterlΣ▀t leeren bildschirm }
  294.   StrLCopy (achName, 'zBlackness', cchName - 1);
  295.   { das erste zeichen des namens wird nicht angezeigt, es legt
  296.     lediglich die sortierung fest. }
  297. {$ifdef ENGLISH}
  298.   StrLCopy (achDesc, 'Blackness:'#10#10'Simply blanks the screen!'#10#10''#10,
  299.         cchDesc - 1);
  300. {$else}
  301.   StrLCopy (achDesc, 'Blackness:'#10#10'Macht den Bildschirm schwarz'#10#10'Beispiel eines einfachen Screen Savers'#10,
  302.         cchDesc - 1);
  303. {$endif}
  304. end;
  305.  
  306. { ScreenSaverOptions - der uebergebene Fensterhandle sollte als ParentWindow
  307.   für die Dialogbox benutzt werden }
  308. Procedure ScreenSaverOptions (window: hWND);
  309. export;
  310. begin
  311. end;
  312.  
  313.  
  314. { ScreenSaverAbout - Parameter wie bei ScreenSaverOptions }
  315. Procedure ScreenSaverAbout (window: hWND);
  316. export;
  317. begin
  318. {$ifdef ENGLISH}
  319.   {$ifdef SHARE}
  320.   LgdAboutBox (window, 0,
  321.                        'Blackness',
  322.                        '⌐1992-95 Thomas H÷vel Software'#10+
  323.                        'Saturnstr. 45, 53842 Troisdorf, Germany'#10+
  324.                        'All Rights reserved!',
  325.                        FALSE, 3);
  326.   {$else}
  327.   LgdAboutBox (window, 0,
  328.                        'Blackness',
  329.                        '⌐1992-95 Thomas H÷vel Software'#10+
  330.                        'Saturnstr. 45, 53842 Troisdorf, Germany'#10+
  331.                        'All Rights reserved!',
  332.                        TRUE, 3);
  333.   {$endif}
  334. {$else}
  335.   {$ifdef SHARE}
  336.   LgdAboutBox (window, 0,
  337.                        'Blackness',
  338.                        '⌐1992-95 Thomas H÷vel Software'#10+
  339.                        'Saturnstra▀e 45, 53842 Troisdorf, Deutschland'#10+
  340.                        'Alle Rechte vorbehalten!',
  341.                        FALSE, 3);
  342.   {$else}
  343.   LgdAboutBox (window, 0,
  344.                        'Blackness',
  345.                        '⌐1992-95 Thomas H÷vel Software'#10+
  346.                        'Saturnstra▀e 45, 53842 Troisdorf, Deutschland'#10+
  347.                        'Alle Rechte vorbehalten!',
  348.                        TRUE, 3);
  349.   {$endif}
  350. {$endif}
  351.  
  352. (*
  353. {$ifdef ENGLISH}
  354.   messagebox (window, 'Saver module for ''The Lights Go Down'''#10'(C) 1992 Leo Minor', 'Blackness', mb_Ok or mb_ApplModal);
  355. {$else}
  356.   messagebox (window, 'Beispiel zu ''The Lights Go Down'''#10'(C) 1992 Leo Minor', 'Blackness', mb_Ok or mb_ApplModal);
  357. {$endif}
  358. *)
  359. end;
  360.  
  361. {$ifndef RUN}
  362. exports
  363.   ScreenSaverID      index 17,
  364.   ScreenSaverOptions index 18,
  365.   ScreenSaver        index 19,
  366.   ScreenSaverAbout   index 20;
  367. {$endif}
  368.  
  369. begin
  370. {$ifdef RUN}
  371.   ScreenSaver (20, 0);  { demo fⁿr ca. 20 sekunden }
  372. {$endif}
  373. end.
  374.